home *** CD-ROM | disk | FTP | other *** search
- /* setprn.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /* Common Block Declarations */
-
- struct {
- integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
- nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
- junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
- numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
- iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
- lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
- nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
- irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
- lvntmp;
- } tabinf_;
-
- #define tabinf_1 tabinf_
-
- struct {
- doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
- sfactr;
- integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
- itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
- } status_;
-
- #define status_1 status_
-
- struct {
- doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas,
- rstats[50];
- integer iwidth, lwidth, nopage;
- } miscel_;
-
- #define miscel_1 miscel_
-
- struct {
- doublereal tcstar[2], tcstop[2], tcincr[2];
- integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
- } dc_;
-
- #define dc_1 dc_
-
- struct {
- doublereal fstart, fstop, fincr, skw2, refprl, spw2;
- integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
- } ac_;
-
- #define ac_1 ac_
-
- struct {
- doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
- integer jtrflg;
- } tran_;
-
- #define tran_1 tran_
-
- struct {
- doublereal xincr, string[15], xstart, yvar[8];
- integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
- } outinf_;
-
- #define outinf_1 outinf_
-
- struct {
- doublereal value[200000];
- } blank_;
-
- #define blank_1 blank_
-
- /* Table of constant values */
-
- static integer c__1 = 1;
- static integer c__7 = 7;
-
- /*< subroutine setprn(loc) >*/
- /* Subroutine */ int setprn_(loc)
- integer *loc;
- {
- /* Initialized data */
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_17 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
-
- #define ablnk (*(doublereal *)&equiv_17)
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_18 = { {' ', ' ', 't', 'i', 'm', 'e', ' ', ' '}, 0. };
-
- #define atimex (*(doublereal *)&equiv_18)
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_19 = { {' ', ' ', 'f', 'r', 'e', 'q', ' ', ' '}, 0. };
-
- #define afreq (*(doublereal *)&equiv_19)
-
-
- /* Format strings */
- static char fmt_91[] = "(/3x,a8,5x,14a8,a4)";
- static char fmt_101[] = "(\002x\002/\002 \002)";
-
- /* System generated locals */
- integer i_1, i_2;
-
- /* Builtin functions */
- integer s_wsfe(), do_fio(), e_wsfe();
-
- /* Local variables */
- static integer loce, loct;
- extern /* Subroutine */ int move_();
- static integer ipos, npos, i, j, itemp, jstop;
- #define nodplc ((integer *)&blank_1)
- #define cvalue ((complex *)&blank_1)
- static doublereal asweep;
- extern /* Subroutine */ int outnam_();
-
- /* Fortran I/O blocks */
- static cilist io__15 = { 0, 0, 0, fmt_91, 0 };
- static cilist io__16 = { 0, 0, 0, fmt_101, 0 };
-
-
- /*< implicit double precision (a-h,o-z) >*/
-
- /* this routine formats the column headers for tabular listings of */
- /* output variables. */
-
- /* spice version 2g.6 sccsid=tabinf 3/15/83 */
- /*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
- /*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
- /*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
- /*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
- /*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
- /*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
- /*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
- /*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
- /* spice version 2g.6 sccsid=status 3/15/83 */
- /*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
- /*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
- /*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
- /* spice version 2g.6 sccsid=miscel 3/15/83 */
- /*< common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
- /*< 1 defas,rstats(50),iwidth,lwidth,nopage >*/
- /* spice version 2g.6 sccsid=dc 3/15/83 */
- /*< common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
- /*< 1 kinel,kidin,kovar,kidout >*/
- /* spice version 2g.6 sccsid=ac 3/15/83 */
- /*< common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
- /*< 1 inoise,nosprt,nosout,nosin,idist,idprt >*/
- /* spice version 2g.6 sccsid=tran 3/15/83 */
- /*< common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
- /* spice version 2g.6 sccsid=outinf 3/15/83 */
- /*< common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
- /*< 1 ilogy(8),npoint,numout,kntr,numdgt >*/
- /* spice version 2g.6 sccsid=blank 3/15/83 */
- /*< common /blank/ value(200000) >*/
- /*< integer nodplc(64) >*/
- /*< complex cvalue(32) >*/
- /*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
-
- /*< data ablnk, atimex, afreq / 1h , 6h time, 6h freq / >*/
-
- /* set limits depending upon the analysis mode */
-
- /*< if (mode-2) 10,20,30 >*/
- if ((i_1 = status_1.mode - 2) < 0) {
- goto L10;
- } else if (i_1 == 0) {
- goto L20;
- } else {
- goto L30;
- }
- /*< 10 xstart=tcstar(1) >*/
- L10:
- outinf_1.xstart = dc_1.tcstar[0];
- /*< xincr=tcincr(1) >*/
- outinf_1.xincr = dc_1.tcincr[0];
- /*< npoint=icvflg >*/
- outinf_1.npoint = dc_1.icvflg;
- /*< itemp=itcelm(1) >*/
- itemp = dc_1.itcelm[0];
- /*< loce=nodplc(itemp+1) >*/
- loce = nodplc[itemp];
- /*< asweep=value(loce) >*/
- asweep = blank_1.value[loce - 1];
- /*< go to 40 >*/
- goto L40;
- /*< 20 xstart=tstart >*/
- L20:
- outinf_1.xstart = tran_1.tstart;
- /*< xincr=tstep >*/
- outinf_1.xincr = tran_1.tstep;
- /*< npoint=jtrflg >*/
- outinf_1.npoint = tran_1.jtrflg;
- /*< asweep=atimex >*/
- asweep = atimex;
- /*< go to 40 >*/
- goto L40;
- /*< 30 xstart=fstart >*/
- L30:
- outinf_1.xstart = ac_1.fstart;
- /*< xincr=fincr >*/
- outinf_1.xincr = ac_1.fincr;
- /*< npoint=icalc >*/
- outinf_1.npoint = status_1.icalc;
- /*< asweep=afreq >*/
- asweep = afreq;
-
- /* construct and print the output variable names */
-
- /*< 40 loct=loc+2 >*/
- L40:
- loct = *loc + 2;
- /*< ipos=1 >*/
- ipos = 1;
- /*< npos=ipos+numdgt+8 >*/
- npos = ipos + outinf_1.numdgt + 8;
- /*< do 90 i=1,kntr >*/
- i_1 = outinf_1.kntr;
- for (i = 1; i <= i_1; ++i) {
- /*< loct=loct+2 >*/
- loct += 2;
- /*< itab(i)=nodplc(loct) >*/
- outinf_1.itab[i - 1] = nodplc[loct - 1];
- /*< itype(i)=nodplc(loct+1) >*/
- outinf_1.itype[i - 1] = nodplc[loct];
- /*< call outnam(itab(i),itype(i),string,ipos) >*/
- outnam_(&outinf_1.itab[i - 1], &outinf_1.itype[i - 1],
- outinf_1.string, &ipos);
- /*< if (ipos.ge.npos) go to 70 >*/
- if (ipos >= npos) {
- goto L70;
- }
- /*< do 60 j=ipos,npos >*/
- i_2 = npos;
- for (j = ipos; j <= i_2; ++j) {
- /*< call move(string,j,ablnk,1,1) >*/
- move_(outinf_1.string, &j, &ablnk, &c__1, &c__1);
- /*< 60 continue >*/
- /* L60: */
- }
- /*< ipos=npos >*/
- ipos = npos;
- /*< go to 80 >*/
- goto L80;
- /*< 70 call move(string,ipos,ablnk,1,1) >*/
- L70:
- move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__1);
- /*< ipos=ipos+1 >*/
- ++ipos;
- /*< 80 npos=npos+numdgt+8 >*/
- L80:
- npos = npos + outinf_1.numdgt + 8;
- /*< 90 continue >*/
- /* L90: */
- }
- /*< call move(string,ipos,ablnk,1,7) >*/
- move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__7);
- /*< jstop=(ipos+6)/8 >*/
- jstop = (ipos + 6) / 8;
- /*< write (iofile,91) asweep,(string(j),j=1,jstop) >*/
- io__15.ciunit = status_1.iofile;
- s_wsfe(&io__15);
- do_fio(&c__1, (char *)&asweep, (ftnlen)sizeof(doublereal));
- i_1 = jstop;
- for (j = 1; j <= i_1; ++j) {
- do_fio(&c__1, (char *)&outinf_1.string[j - 1], (ftnlen)sizeof(
- doublereal));
- }
- e_wsfe();
- /*< 91 format(/3x,a8,5x,14a8,a4) >*/
- /*< write (iofile,101) >*/
- io__16.ciunit = status_1.iofile;
- s_wsfe(&io__16);
- e_wsfe();
- /*< 101 format(1hx/1h ) >*/
- /*< return >*/
- return 0;
- /*< end >*/
- } /* setprn_ */
-
- #undef cvalue
- #undef nodplc
- #undef afreq
- #undef atimex
- #undef ablnk
-
-
-